home *** CD-ROM | disk | FTP | other *** search
- /*
-
- This is the pseudo class definition for Class for GCOOPE Ver 1.0.
-
- by Brian Lee Price
-
- Released as Public Domain July, 1994.
-
- */
-
- #define __CLASS_DEFINITION__
-
- #include "gcstruct.h"
-
- #include <stdarg.h>
-
-
- /*
- AVAILABLE FOR EXTERNAL USE.
-
- This routine's main use is to inherit the ancestor methods for
- a new class. However, it can be called by a pseudo-class or an
- actual class definition to inherit only the methods (not the
- instance variables) of a non-ancestor class. I'm not sure of what
- practical use it will be used in this manner, but... who knows?
- */
-
- stat inhMthd(object class, object super)
- {
- int numPar;
- int numMthds;
- superEntry * parent;
- classEntry * clsEnt;
- methodEntry * meths;
- stat retVal=FUNCFAIL;
-
-
- if(class==Object || super==Object || NULL==(clsEnt=getObjDef((tag)super)))
- goto end;
- (char *) parent=&(clsEnt->cVars[clsEnt->cvSize]);
- numPar=clsEnt->numSuper;
- numMthds=clsEnt->numMthds;
- parent+=numPar;
- (superEntry *) meths = parent;
- numPar--;
- parent--;
- for(;numPar>=0;numPar--,parent--)
- {
- if(inhMthd(class,parent->class)) goto end;
- }
- for(;numMthds>0;numMthds--,meths++)
- {
- if(addMethod(meths->genTag,meths->clsMthd,(tag) class,
- (tag) super)) goto end;
- }
- retVal=FUNCOKAY;
-
- end:
- return retVal;
- }
-
-
- /*
- AVAILABE VIA CALL TO New with Class as the instance object.
-
- This routine creates a new class, installing it into the
- object system.
-
- */
-
- static object newClass(object instance, int cvSize, int ivSize,...)
- {
- va_list ap;
- int totSz;
- int numPar=0;
- object temp;
- classEntry * clsEnt;
- classEntry * parEnt;
- superEntry * parent;
- int curOff;
-
- totSz=sizeof(classEntry)+cvSize+(sizeof(methodEntry)*MIN_METHOD_ADD);
- va_start(ap,ivSize);
- while(END!=(temp=va_arg(ap,object)))
- {
- if(NULL==(clsEnt=getObjDef((tag) temp))) goto err1;
- if(clsEnt->class!=(tag) instance) goto err1;
- numPar++;
- }
- va_end(ap);
- totSz+= sizeof(superEntry)*numPar;
- clsEnt=s_calloc(1,totSz);
- clsEnt->cvSize=cvSize;
- clsEnt->ivSize=curOff=ivSize;
- curOff+=sizeof(int);
- clsEnt->numSuper=numPar;
- clsEnt->numMthds=0;
- clsEnt->loadAdr=NULL;
- clsEnt->class=(tag) instance;
- if(((tag)instance=addObject(clsEnt,PERM_PROC_ID))<0) goto err2;
- (char *) parent= &(clsEnt->cVars[clsEnt->cvSize]);
-
- va_start(ap,ivSize);
- for(;numPar>0;numPar--,parent++)
- {
- temp=va_arg(ap,object);
- parEnt=getObjDef(parent->class=(tag) temp);
- parent->offset=curOff;
- curOff+=parEnt->totSize;
- }
- clsEnt->totSize=curOff;
- if(inhMthd(instance,instance)) goto err3;
- return instance;
-
- err3:
- rmvObject((tag)instance);
- err2:
- s_free(clsEnt);
- err1:
- return (object) END;
- }
-
-
- /*
- AVAILABLE FOR EXTERNAL USE.
-
- This routine adds a method to a generic function, if the
- function does not yet exist, it will create it.
-
- */
-
- stat addGMthd(object class, generic genTag, method addMth)
- {
- classEntry * clsEnt;
- superEntry * parEnt;
- methodEntry * mthEnt;
- objectEntry * objEnt;
- stat retVal=FUNCFAIL;
-
- if((method) NULL == addMth ||
- NULL==(clsEnt=getObjDef((tag) class)) || class==Object) goto end;
- if(addMethod(genTag, addMth, (tag) class, (tag) class)) goto end;
- if(NULL==(clsEnt=getObjDef((tag) class)) || clsEnt->class!=Class)
- {
- rmvMethod(genTag, (tag) class);
- goto end;
- }
- if(clsEnt->numMthds && !(clsEnt->numMthds%MIN_METHOD_ADD))
- {
- clsEnt=s_realloc(clsEnt, sizeof(classEntry) + clsEnt->cvSize +
- sizeof(superEntry)*clsEnt->numSuper +
- sizeof(methodEntry)*(clsEnt->numMthds + MIN_METHOD_ADD));
- objEnt=getObject((tag) class);
- objEnt->objDef=clsEnt;
- }
- (char *) parEnt = &(clsEnt->cVars[clsEnt->cvSize]);
- parEnt+=clsEnt->numSuper;
- mthEnt=(methodEntry *) parEnt;
- mthEnt+=clsEnt->numMthds;
- mthEnt->genTag=genTag;
- mthEnt->clsMthd=addMth;
- clsEnt->numMthds++;
-
- retVal=FUNCOKAY;
- end:
- return retVal;
- }
-
-
- stat cpyGMas(object newClass, generic newGenFunc,
- object oldClass, generic oldGenFunc)
- {
- genMethod * oldRcd;
-
- if(NULL==(oldRcd=getMthd(oldGenFunc, (tag) oldClass))) goto err;
- if(addGMthd(oldRcd->owner, newGenFunc, oldRcd->instMethod)) goto err;
- if(addMethod(newGenFunc, oldRcd->instMethod, (tag) newClass,
- (tag) oldRcd->owner)) goto err;
- return FUNCOKAY;
-
- err:
- return FUNCFAIL;
- }
-
-
- /*
- AVAILABLE FOR EXTERNAL USE.
-
- The prime use of this function is to block an ancestor
- generic from directly acting on the main instance.
- */
-
- stat rmvGMthd(object class, generic genTag)
- {
-
- if(class==Object) return FUNCFAIL;
- return rmvMethod(genTag, (tag) class);
- }
-
-
- /*
- AVAILABLE AS THE METHOD FOR Kill with the instance == Class
-
- This routine will remove a class from the system, it will
- also remove any ancestors which become dereferenced and will
- indirectly remove all generics which become dereferenced.
- */
-
- static object killClass(object instance, object class)
- {
- classEntry * clsEnt;
- methodEntry * mthEnt;
- int retVal=FUNCFAIL;
- int x;
-
- if(NULL==(clsEnt=getObjDef((tag) class))) goto end;
- if(clsEnt->class!=Class) goto end;
-
- (char *) mthEnt = &(clsEnt->cVars[clsEnt->cvSize]);
- (superEntry *) mthEnt +=clsEnt->numSuper;
- for(x=clsEnt->numMthds;x>0;x--,mthEnt++)
- {
- rmvMethod(mthEnt->genTag, (tag) instance);
- }
-
- rmvObject((tag) class);
- retVal=FUNCOKAY;
-
- end:
- return (object) retVal;
- }
-
-
-
- /*
- FOR KERNEL USE ONLY.
-
- This routine installs the pseudo class Class.
- */
-
-
- stat Class_Install(void)
- {
- stat retVal=FUNCFAIL;
- classEntry * clsEnt;
-
- Class=(object) 1;
- if((object) END == (Class=newClass(Class,0,0,END))) goto end;
- if(Class!=1)
- {
- if(NULL==(clsEnt=getObjDef((tag) Class))) goto err;
- clsEnt->class=(tag) Class;
- }
- if(addMethod(New,(method) newClass, (tag) Class, (tag) Class)) goto err;
- if(addMethod(Kill,(method) killClass, (tag) Class, (tag) Class)) goto err;
- retVal=FUNCOKAY;
-
- end:
- return retVal;
-
- err:
- killClass(Class, Class);
- return retVal;
- }
-
-